home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / stsim2.zip / MENU.SYS < prev    next >
Text File  |  1993-04-01  |  2KB  |  89 lines
  1. unit menu;
  2. { *************************
  3.    Menu System Revision 1
  4.         Print(var s:text)
  5.           prints screen;
  6.    f(x) Process(var s:text)
  7.           process the screen
  8.           and return choice
  9.   ************************* }
  10.  
  11. interface
  12. procedure print(var s:text);
  13.  
  14. implementation
  15. procedure print(var s:text);
  16. var
  17.         ch:char;
  18. begin
  19.         reset(s);
  20.         repeat
  21.                 read(s,ch);
  22.                 if ch='~' then exit;
  23.                 write(ch);
  24.         until eof(s);
  25. end;
  26.  
  27. function process(var s:text):string;
  28. var
  29.         ch:char;
  30.         tmp_string:string;
  31.         int_code:string;
  32.  
  33.   procedure input(s:string);
  34.   var
  35.         i,nchoice:integer;
  36.         acc:string;
  37.         choice:array[1..100] of string[30];
  38.    begin
  39.         acc:='';
  40.         nchoice:=1;
  41.         for i:=1 to length(s) do begin
  42.                 if s[i]=',' then begin
  43.                         choice[nchoice]:=acc;
  44.                         inc(nchoice);
  45.                         acc:='';
  46.                 end else
  47.                 acc:=acc+s[i];
  48.         end;
  49.         { ----------match choice---------}
  50.     readln(acc);
  51.         for i:=1 to nchoice do begin
  52.                 if acc=choice[i] then
  53.                     process:=acc;
  54.         end;
  55.         {---------------------------------}
  56.  
  57.    end;
  58.  
  59. begin
  60.         process:='~(nil)';
  61.         reset(s);
  62.         int_code:='';
  63.         {------read until processing-------}
  64.         repeat
  65.                 read(s,ch);
  66.                 if ch='~' then begin
  67.                         int_code:='break';
  68.                 end;
  69.         until eof(s) or (int_code='break');
  70.         {----------------------------------}
  71.         repeat
  72.                 read(s,ch);
  73.                 case ch of
  74.                 '{': begin
  75.                         tmp_string:='';
  76.                         repeat
  77.                           read(s,ch);
  78.                           tmp_string:=tmp_string+ch;
  79.                         until ch='}';
  80.             delete(tmp_string,length(tmp_string),1);
  81.             tmp_string:=tmp_string+',';
  82.                         input(tmp_string);
  83.                      end;
  84.                 end;
  85.         until eof(s);
  86. end;
  87.  
  88. end.
  89.